home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
faq-s.zip
/
WAITCALL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-04
|
45KB
|
1,656 lines
{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
{$M 65500,0,0 }
unit waitcall;
interface
uses dos,crt,main,netnew,video,
gentypes,statret,configrt,modem,gensubs,subs1,subs2,mailret,overlay,
overret1,mainr1,mainr2,mainmenu,getlogin,userret,protocol,Graph3,drivers,mousedlg;
function waitforacall:boolean;
implementation
function waitforacall:boolean;
const statwindx=2;
statwindy=1;
firstcolx=17;
firstline=1;
secondcolx=41;
thirdcolx=66;
var wscount :integer;
modemoff :boolean;
mustgetbaud :boolean;
outf :text;
screen :screens;
screenblank :boolean;
nl :netmailrec;
nla :netlistrec;
msg :string[40];
anynum :integer;
msgnum :integer;
msgcount :integer;
color1,color2,color3,
color4,color5,color6,
color7,color8,color9,
color10,color11,color12,
color13,color14,color15:integer;
blanker:minuterec;
procedure cursor (b:boolean);
var r:registers;
begin
with r do begin
ah:=$01;
if not b then begin
ch:=$20; cl:=$20
end else begin
ch:=5; cl:=7
end
end;
intr ($10,r)
end;
procedure col1;
begin
{ window (statwindx+firstcolx,statwindy+firstline,80,25);
}end;
procedure col2;
begin
{ window (statwindx+secondcolx,statwindy+firstline,80,25);
}end;
procedure col3;
begin
{ window (statwindx+thirdcolx,statwindy+firstline,80,25);
}end;
procedure seeknmfile (n:integer);
begin
seek (nmfile,n-1);
end;
procedure seeknlifile (n:integer);
begin
seek (nlifile,n-1);
end;
function numbbs:integer;
begin
numbbs:=filesize (nmfile);
end;
function numnetfiles:integer;
begin
numnetfiles:=filesize(nlifile)
end;
procedure delfile(laym:byte);
var i :integer;
n :integer;
cnt :integer;
c :char;
begin
n:=laym;
seeknlifile (n);
read (nlifile,nla);
for cnt:=n to numnetfiles-1 do
begin
seeknlifile (cnt+1);
read (nlifile,nla);
seeknlifile (cnt);
write (nlifile,nla)
end;
seeknlifile (numnetfiles);
truncate (nlifile);
end;
procedure topwin;
begin;
window(3,7,79,14);
textcolor(statlinecolor);
end;
procedure botwin;
begin;
window(3,18,79,22);
textcolor(splitcolor);
end;
procedure maybewritestatus;
begin
msgcount:=msgcount+1;
anynum:=0;
repeat
color1:=color1+1;
color2:=color2+1;
color3:=color3+1;
color4:=color4+1;
color5:=color5+1;
color6:=color6+1;
color7:=color7+1;
color8:=color8+1;
color9:=color9+1;
color10:=color10+1;
color11:=color11+1;
color12:=color12+1;
color13:=color13+1;
color14:=color14+1;
color15:=color15+1;
if color1=16 then begin
color1:=color1-15;
end;
if color2=16 then begin
color2:=color2-15;
end;
if color3=16 then begin
color3:=color3-15;
end;
if color4=16 then begin
color4:=color4-15;
end;
if color5=16 then begin
color5:=color5-15;
end;
if color6=16 then begin
color6:=color6-15;
end;
if color7=16 then begin
color7:=color7-15;
end;
if color8=16 then begin
color8:=color8-15;
end;
if color9=16 then begin
color9:=color9-15;
end;
if color10=16 then begin
color10:=color10-15;
end;
if color11=16 then begin
color11:=color11-15;
end;
if color12=16 then begin
color12:=color12-15;
end;
if color13=16 then begin
color13:=color13-15;
end;
if color14=16 then begin
color14:=color14-15;
end;
if color15=16 then begin
color15:=color15-15;
end;
if not screenblank then begin
gotoxy (13,11);
textcolor (color1);
write (usr,'F');
textcolor (color2);
write (usr,'A');
textcolor (color3);
write (usr,'Q ');
textcolor (color4);
write (usr,copy (ver,1,1));
textcolor (color5);
write (usr,copy (ver,2,1));
textcolor (color6);
write (usr,copy (ver,3,1));
textcolor (color7);
write (usr,copy (ver,4,1)+' ');
textcolor (color8);
write (usr,copy (date,1,1));
textcolor (color9);
write (usr,copy (date,2,1));
textcolor (color10);
write (usr,copy (date,3,1));
textcolor (color11);
write (usr,copy (date,4,1));
textcolor (color12);
write (usr,copy (date,5,1));
textcolor (color13);
write (usr,copy (date,6,1));
textcolor (color14);
write (usr,copy (date,7,1));
textcolor (color15);
write (usr,copy (date,8,1));
end;
delay(100{80});
anynum:=anynum+1;
textcolor(normtopcolor);
until (carrier) or (keyhit) or (anynum>15);
if msgcount>15 then begin
textcolor(normtopcolor);
msgnum:=msgnum+1;
if msgnum>8 then begin
msg:=' ';
msgnum:=1;
end;
if msgnum=1 then begin
msg:=' FAQ Communications/BBS Software ';
gotoxy(3,17);
textcolor(normtopcolor);
end;
if msgnum=2 then begin
msg:=' Author: The Firegod ';
gotoxy(3,17);
textcolor(normtopcolor);
end;
if msgnum=3 then begin
msg:=' Co-Author: The Witch Doctor ';
gotoxy(3,17);
textcolor(normtopcolor);
end;
if msgnum=4 then begin
msg:=' (C)Copyright BaseTwo Software, 1991 ';
gotoxy(3,17);
textcolor(normtopcolor);
end;
if msgnum=5 then begin
msg:=' FAQ - The BBS Software of the 90''s ';
gotoxy(3,17);
textcolor(normtopcolor);
end;
if msgnum=6 then begin
msg:=' FAQ has been brought to you by ';
gotoxy(3,17);
textcolor(normtopcolor);
end;
if msgnum=7 then begin
msg:=' The FAQ Development Team ';
gotoxy(3,17);
textcolor(normtopcolor);
end;
if msgnum=8 then begin
msg:=' Thank you for choosing FAQ! ';
gotoxy(3,17);
textcolor(normtopcolor);
end;
if not screenblank then write (usr,msg);
textcolor(normtopcolor);
end;
wscount:=wscount+1;
if wscount>800 then begin
writestatus;
wscount:=0
end;
end;
Function checkforhayesreport:Boolean;
Var n:longint;
q:lstr;
p,b:Integer;
k:Char;
bd,brate:baudratetype;
Begin
delay (50);
q:='';k:=' ';
bd:=b110;
While (numchars>0) And (Length(q)<99) Do Begin
k:=getchar;q:=q+k;
End;
delay (500);
While (numchars>0) And (Length(q)<150) Do Begin
k:=getchar;
q:=q+k;
End;
If Not carrier Then exit;
if (Pos('ARQ',q)>0) or (Pos('MNP',q)>0) then arq:=true else arq:=false;
{if (defbaudrate=19200) or (defbaudrate=38400) and (lockport) then begin
writeln (usr,'[Locking the COM Port in 38400]');
bd:=b38400 end else} begin
If ((Pos('1',q)>0) or (Pos('CONNECT',q)>0)) and (defbaudrate>=300) Then bd:=b300;
If ((Pos('5',q)>0) or (Pos('CONNECT 1200',q)>0)) and (defbaudrate>=1200) Then bd:=b1200;
If ((Pos('10',q)>0) or (Pos('CONNECT 2400',q)>0)) and (defbaudrate>=2400) Then bd:=b2400;
If ((Pos('18',q)>0) or (Pos('CONNECT 4800',q)>0)) and (defbaudrate>=4800) Then bd:=b4800;
If ((Pos('13',q)>0) or (Pos('CONNECT 9600',q)>0)) and (defbaudrate>=9600) Then bd:=b19200;
If ((Pos('50',q)>0) or (Pos('CONNECT 19200',q)>0)) and (defbaudrate>=19200) Then bd:=b38400;
if bd=b110 then begin
if defbaudrate=300 then bd:=b300;
if defbaudrate=1200 then bd:=b1200;
if defbaudrate=2400 then bd:=b2400;
if defbaudrate=4800 then bd:=b4800;
if defbaudrate=9600 then bd:=b9600;
if defbaudrate=19200 then bd:=b19200;
if defbaudrate=38400 then bd:=b38400;
end;
end;
If (bd>b110) Then Begin
parity:=False;
baudrate:=baudarray[bd];
mustgetbaud:=False;
checkforhayesreport:=True;
End Else Checkforhayesreport:=False;
End;
(***
{function checkforhayesreport:boolean; { Looks for CONNECT 300 }
var n:longint;
q:sstr;
p,b:integer;
k:char;
brate:baudratetype;
const lookfor:sstr=#13#10'CONNECT ';
begin
checkforhayesreport:=false;
if numchars=0 then exit;
p:=1;
q:='';
b:=0;
repeat
n:=now;
repeat until (now>n+1) or (numchars>0);
if numchars=0 then exit else k:=getchar;
if (k=#13) and (length(q)>0) then begin
val (q,b,p);
brate:=b300;
while (brate<=b38400) and
((b<>baudarray[brate])
or (not (brate in supportedrates)))
do brate:=succ(brate);
if brate<=b38400 then begin
parity:=false;
baudrate:=b;
checkforhayesreport:=true;
mustgetbaud:=false;
n:=now;
repeat until carrier or (now>n+1)
end;
exit
end;
if p>length(lookfor) then q:=q+k else begin
if k=lookfor[p] then p:=p+1 else begin
b:=b+1;
if b=2 then exit
end
end
until false
end;}
***)
{ procedure receivecall;
var b:byte;
timeout,autoswitch:integer;
k:char;
brate:baudratetype;
procedure nextrate (var b:baudratetype);
var ob:baudratetype;
begin
ob:=b;
repeat
b:=succ(b);
if b>b38400 then b:=b300;
if b=ob then exit
until b in supportedrates
end;
procedure disconnect;
begin
if (carrier or local) then hangupmodem;
baudrate:=defbaudrate;
parity:=false;
setparam(usecom,baudrate,parity);
setupmodem
end;
function seconds:integer;
var r:registers;
begin
r.ah:=$2c;
intr ($21,r);
seconds:=r.dh
end; }
procedure receivecall;
var b:byte;
timeout,autoswitch:integer;
k:char;
brate:baudratetype;
matrix:anystr;
joemam:anystr;
brow:integer;
lowbaud:integer;
procedure nextrate (var b:baudratetype);
var ob:baudratetype;
begin
ob:=b;
repeat
b:=succ(b);
if b>b38400 then b:=b300;
if b=ob then exit
until b in supportedrates
end;
procedure disconnect;
begin
if carrier then hangupmodem;
baudrate:=defbaudrate;
parity:=false;
setparam (usecom,baudrate,parity);
setupmodem
end;
function seconds:integer;
var r:registers;
begin
r.ah:=$2c;
intr ($21,r);
seconds:=r.dh
end;
label abort,connected;
var return:string;
begin
local:=false;
online:=false;
textcolor (normbotcolor);
window (1,1,80,25);
clrscr;
window (1,1,80,24);
if checkforhayesreport then goto connected;
if not mustgetbaud then goto connected;
writeln;
brate:=b300;
parity:=false;
timeout:=timer+2;
repeat
nextrate (brate);
baudrate:=baudarray[brate];
textcolor (outlockcolor);
textbackground (0);
writeln (usr,^M^J'Trying [',baudrate,']:');
online:=true;
if numchars=0 then begin
return:=^B+^M+'-Press Return';
for b:=1 to length(return) do begin
sendchar (return[b]); write (usr,return[b]);
if numchars>0 then b:=length(return);
end;
end;
while numchars>0 do k:=getchar;
autoswitch:=seconds+3;
if autoswitch>59 then autoswitch:=autoswitch-60;
repeat until (not carrier) or (numchars>0) or (keyhit) or
(timer>=timeout) or (autoswitch=seconds);
if timer>=timeout then hangupmodem;
if not carrier then goto abort;
if keyhit
then
begin
k:=bioskey;
case upcase(k) of
#13:goto connected;
'D':goto abort;
end
end
else
begin
if numchars>0 then begin
b:=ord(getchar);
end else b:=0;
if b<>13
then if b=141
then parity:=true
else
begin
delay (200);
while numchars>0 do b:=ord(getchar)
end
end
until (b=13) or (b=141) or (timer>timeout);
if timer<=timeout then begin
connected:
setparam (usecom,baudrate,parity);
if parity
then baudstr:='E,7'
else baudstr:='N,8';
baudstr:=strr(baudrate)+','+baudstr+',1';
online:=true;
urec.config:=[lowercase,linefeeds,eightycols];
newcalls:=newcalls+1;
delay (750);
cursor (true);
if carrier then exit
end;
abort:
disconnect
end;
procedure exitprog;
Begin
sendmodemstr ('~~ATS0=0Q0M1V1X7|',true);
dontanswer;
TextMode(80);
window (1,1,80,25);
clrscr;
textbackground (0);
textcolor (normbotcolor);
gotoxy (1,1);
writeln (usr,' ┌──────────────────────────────────────────────────────────────────────────┐');
gotoxy (1,2);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' FAQ '+ver+' - '+date+' ');
textcolor (normbotcolor);
writeln (usr,'│');
textcolor (normbotcolor);
gotoxy (1,3);
write (usr,' │');
textcolor (normtopcolor);
write (usr,' FAQ "F-A-Q" - Functional and Quick. ');
textcolor (normbotcolor);
writeln (usr,'│');
textcolor (normbotcolor);
gotoxy (1,4);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' Authors - The Firegod and The Witch Doctor ');
textcolor (normbotcolor);
writeln (usr,'│');
gotoxy (1,5);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' of BaseTwo Software ');
textcolor (normbotcolor);
writeln (usr,'│');
textcolor (normbotcolor);
gotoxy (1,6);
writeln (usr,' └──────────────────────────────────────────────────────────────────────────┘');
ensureclosed;
ClosePort;
ansicolor (7);
textcolor (7);
halt (4);
end;
procedure checkday;
begin
if lastdayup<>datestr(now) then begin
lastdayup:=datestr(now);
numdaysup:=numdaysup+1;
callstoday:=0;
writestatus
end
end;
procedure useredit;
{$M 8192,0,0} { Leave memory for child process }
var
Command: string[127];
begin
Command:=('Uedit');
begin
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C ' + Command);
SwapVectors;
end;
TextMode(80);
Clrscr;
end;
procedure Futil;
var
Command2: string[127];
begin
TextMode(80);
ClrScr;
Command2:=('Futil');
begin
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C ' + Command2);
SwapVectors;
end;
TextMode(80);
Clrscr;
end;
procedure Run_Config;
var
Command2: string[127];
begin
TextMode(80);
ClrScr;
Command2:=('SETUP');
begin
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C ' + Command2);
SwapVectors;
end;
TextMode(80);
Clrscr;
end;
procedure Run_Prot_Config;
var
Command2: string[127];
begin
TextMode(80);
ClrScr;
Command2:=('Protedit');
begin
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C ' + Command2);
SwapVectors;
end;
TextMode(80);
Clrscr;
end;
procedure Run_Sound;
var
Command2: string[127];
begin
TextMode(80);
ClrScr;
Command2:=('Sound.Bat');
begin
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C ' + Command2);
SwapVectors;
end;
TextMode(80);
Clrscr;
end;
procedure dotimedevent;
var tf:text;
begin
window (1,1,80,25);
clrscr;
writeln (usr,'Executing timed event: ',eventbatch);
writeln (usr);
assign (tf,'Door.bat');
rewrite (tf);
writeln (tf,eventbatch);
textclose (tf);
timedeventdate:=datestr(now);
ensureclosed;
ansicolor (7);
textcolor (7);
halt (3)
end;
procedure donetworkevent;
var tf:text;
begin
window (1,1,80,25);
clrscr;
writeln (usr,'Executing network call: ',netstart);
writeln (usr);
repeat
if usemouse then hidemouse;
NewNetSend;
until (timestr(now)=netend);
end;
function statusscreen:char;
procedure percent (r1,r2:real);
begin
if (r2<1) then exit;
r2:=round((r1/r2)*1000)/10;
writeln (usr,r2:0:1,'%')
end;
procedure writefreespace;
var r:registers; tempfree:real; lp:integer; total:real;
csize:real;
function unsigned (i:integer):real;
begin
if i>=0 then unsigned:=i else unsigned:=65536.0+i
end;
begin
total:=0;
for lp:=3 to 15 do begin
r.ah:=$1c;
r.dl:=lp;
intr ($21,r);
if mem[r.ds:r.bx]=$f8 then begin
r.ah:=$36;
r.dl:=lp;
intr ($21,r);
csize:=unsigned(r.ax)*unsigned(r.cx);
tempfree:=(csize*unsigned(r.bx))/1000;
total:=total+tempfree/1000;
gotoxy(67,5);
textcolor(normtopcolor);
write(usr,streal(total)+' meg(s)');
end;
end;
end;
procedure drawstatus;
var totalidle,totalup,totalmins,r:real;
tmp,nettmp:integer;
begin
if screenblank then exit;
{col1;}
tmp:=timetillevent;
if (tmp<=30) then begin
gotoxy (4,18);
write (usr,'Event scheduled in ',tmp,' min.');
if (tmp<=5) then begin
dontanswer;
if tmp<=2 then dotimedevent;
end
end;
nettmp:=timenetworkevent;
if (nettmp<=30) and (usenet) then begin
gotoxy (4,19);
write (usr,'Network Event scheduled in ',nettmp,' min.');
if (nettmp<=5) and (usenet) then begin
dontanswer;
if (nettmp<=2) and (usenet) then donetworkevent;
end
end;
if carrier or keyhit then exit;
gotoxy (4,20);
if getenv ('DSZLOG')<>dszlogname then write (usr,'DSZ Log not set') else
write(usr,'DSZ Log: '+dszlogname);
gotoxy (11,22); write(usr,timestr(now));
gotoxy (20,22); write(usr,datestr(now));
gotoxy (14,13); write(usr,netnum);
gotoxy (23,15); if usenet then write(usr,'Yes') else write(usr,'No ');
gotoxy (18,4);
writeln (usr,callstoday);
gotoxy (42,5);
tmp:=elapsedtime (numminsidle);
write (usr,tmp);
writefreespace;
gotoxy (67,4);
writeln (usr,numdaysup);
r:=round(10*numcallers/numdaysup)/10;
gotoxy (18,5);
writeln (usr,r:0:1);
{ col2;
gotoxy (1,3);
totalidle:=numminsidle.total+elapsedtime(numminsidle);
writeln (usr,totalidle:0:0);
totalup:=totalidle+numminsused.total;
writeln (usr,totalup:0:0);
totalmins:=1440.0*(numdaysup-1.0)+timer;
if (totalup<1) or (totalmins<1) then exit;
percent (numminsused.total,totalmins);
percent (numminsxfer.total,totalmins);
percent (totalidle,totalmins);
percent (totalup,totalmins);
percent (totalmins-totalup,totalmins);}
{col1;}
gotoxy (1,1);
maybewritestatus
end;
procedure writeavail;
var ChatM:sstr; m:sstr;
begin
gotoxy (63,22);
{TEST for chat
ChatM:=Timestr(Now);
If Chatm=Availtime then SysopAvailstr='YES';}
m:=sysopavailstr;
while length(m)<13 do m:=m+' ';
write (usr,m);
gotoxy (1,1)
end;
var cnt,numsmail:integer;
k:char;
tmp:mstr;
b:byte;
done:boolean;
function shouldexit:boolean;
begin
shouldexit:=done or carrier
end;
procedure handlekey (k:char; beforeabout:boolean);
begin
b:=ord(k)-128;
case b of
availtogglechar:begin
toggleavail;
if not beforeabout then writeavail
end;
35:sendmodemstr ('+++~~~ATH|',true);
48,59,60,61,62,63,64,65,66,67,68:begin
done:=true;
statusscreen:=k
end
end
end;
procedure writeboardname;
var xcoord:integer; nm:string[50];
begin
nm:=longname;
xcoord:=39-(length(nm) div 2);
textcolor (normtopcolor);
gotoxy(xcoord,24); write(usr,nm);
end;
function interrupted (beforeabout:boolean):boolean;
begin
if keyhit then begin
k:=bioskey;
handlekey (k,beforeabout)
end;
done:=done or carrier;
interrupted:=done
end;
procedure sendstring (x:lstr);
var cnt:integer;
k:char;
begin
for cnt:=1 to length(x) do begin
sendchar(x[cnt]);
delay (20);
end;
delay (50);
while numchars>0 do k:=getchar;
clearoutput;
clearinput;
end;
procedure phonesringing;
begin
{col2;}
gotoxy(37,22);
textcolor (normtopcolor);
write(usr,'Answering Call ');
sendstring (' ATA'#13)
end;
Procedure connectcode(k:Char);
Var timer:word Absolute $40:$6c;
t:word;
k2:Char;
bd:baudratetype;
Begin
t:=timer+18;
Repeat Until (timer>t) Or carrier Or (numchars>0);
k2:=getchar;{ Will be #0 if no chars }
Case k Of
'1' : Case k2 Of
#0 :bd:=b300;
'0' :bd:=b2400;
'6' :bd:=b9600;
Else exit
End;
'5' :bd:=b1200;
Else exit
End;
If bd In supportedrates Then Begin
parity:=False;
baudrate:=baudarray[bd];
mustgetbaud:=False;
t:=timer+18;
Repeat Until carrier Or (timer>t)
End;
End;
var setlog:string[50];
i,iiii:byte;
begin
while numchars>0 do k:=getchar;
clearoutput;
clearinput;
statusscreen:=#0;
done:=false;
window (1,1,80,25);
textcolor (normbotcolor);
clrscr;
{setcursor(cursoroff);}cursor(false);
window (statwindx,statwindy,80,25);
if elapsedtime (blanker)>=1 then screenblank:=true;
if not screenblank then begin
gotoxy (1,1);
{writeln(usr,'┌─────────────────────────────────────┬────────────────────────────────────┐');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,' │');
writeln(usr,'├────────────────────────┬────────────┴───────────┬────────────────────────┤');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,' │');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,' │');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,' │');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,' │');
writeln(usr,'├────────────────────────┴────────────┬───────────┴────────────────────────┤');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'├─────────────────────────────────────┤');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'├─────────────────────────────────────┤');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'├─────────────────────────────────────┤');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│ │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'├─────────────────────────────────────┤');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│ │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│ │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│ │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│ │');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,'│');
writeln(usr,'├──────────────────────────┬──────────┴──────────────┬─────────────────────┤');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,' │');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
writeln(usr,' │');
writeln(usr,'├──────────────────────────┴─────────────────────────┴─────────────────────┤');
writeln(usr,'│ │');
write (usr,'└──────────────────────────────────────────────────────────────────────────┘');
gotoxy (1,1);}
writeln(usr,'┌─────────────────────────────────────┬────────────────────────────────────┐');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,'Registered');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'Serial Number');
textcolor (normbotcolor);
writeln(usr,': │');
writeln(usr,'├────────────────────────┬────────────┴───────────┬────────────────────────┤');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,'Calls Today ');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'Total Calls ');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'Total Days ');
textcolor (normbotcolor);
writeln(usr,': │');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,'Calls / Day ');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'Mins Idle ');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'Free Space ');
textcolor (normbotcolor);
writeln(usr,': │');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,'New Calls ');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'New Posts ');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'New Uploads ');
textcolor (normbotcolor);
writeln(usr,': │');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,'New Feedback');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'New Mail ');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'Sysop Mail ');
textcolor (normbotcolor);
writeln(usr,': │');
writeln(usr,'├────────────────────────┴────────────┬───────────┴────────────────────────┤');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,'Last Caller');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'F1 ');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Force Net Call ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'├─────────────────────────────────────┤');
textcolor (outlockcolor);
write (usr,'F2 ');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Exit FAQ ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,'Version');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'F3 ');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Send Carrier ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'├─────────────────────────────────────┤');
textcolor (outlockcolor);
write (usr,'F4 ');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Send Off Hook ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,'Net Node');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'F5 ');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Run Protocol Setup Program ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'├─────────────────────────────────────┤');
textcolor (outlockcolor);
write (usr,'F6 ');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Run Setup Program ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,'Using CelerityNet');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'F7 ');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Terminal Program ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'├─────────────────────────────────────┤');
textcolor (outlockcolor);
write (usr,'F8 ');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Read Feedback ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,'│');
textcolor (outlockcolor);
write (usr,'F9 ');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Sysop Functions ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,'│');
textcolor (outlockcolor);
write (usr,'F10 ');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Login Local ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,'│');
textcolor (outlockcolor);
write (usr,'ALT-A');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Toggle Chat Status ');
textcolor (normbotcolor);
writeln(usr,'│');
write (usr,'│');
textcolor (outlockcolor);
write (usr,' ');
textcolor (normbotcolor);
write (usr,'│');
textcolor (outlockcolor);
write (usr,'ALT-H');
textcolor (normbotcolor);
write (usr,': ');
if outlockcolor>8 then
textcolor (outlockcolor-8) else textcolor (outlockcolor);
write (usr,'Hang Up Modem ');
textcolor (normbotcolor);
writeln(usr,'│');
writeln(usr,'├──────────────────────────┬──────────┴──────────────┬─────────────────────┤');
write (usr,'│ ');
textcolor (outlockcolor);
write (usr,'Clock');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'Modem');
textcolor (normbotcolor);
write (usr,': │');
textcolor (outlockcolor);
write (usr,'Avail');
textcolor (normbotcolor);
writeln(usr,': │');
writeln(usr,'├──────────────────────────┴─────────────────────────┴─────────────────────┤');
writeln(usr,'│ │');
write (usr,'└──────────────────────────────────────────────────────────────────────────┘');
if interrupted (true) then exit;
window (1,1,80,25);
textcolor (outlockcolor);
if jshutup then begin
if length(getenv('JMODEM'))<1 then
begin
Assign (outf,'SETJ.BAT');
rewrite(outf);
WriteLn(outf,'cls');
WriteLn(outf,'echo Telling Jmodem to shut its mouth - please wait');
writeln(outf,'SET JMODEM=SHUTUP');
WriteLn(outf,'MAIN.BAT');
textclose(outf);
end;
end;
{If timeStr(Now)=Bytime then Sysopavail:=TRUE;}
if interrupted (true) then exit;
writeboardname;
{setupmodem;}
numsmail:=getnummail(1)+numfeedback;
tmp:=getlastcaller;
{col1;}
gotoxy (17,9);
textcolor (normtopcolor);
write (usr,copy(tmp,1,23));
gotoxy (13,11);
textcolor (color1);
write (usr,'F');
textcolor (color2);
write (usr,'A');
textcolor (color3);
write (usr,'Q ');
textcolor (color4);
write (usr,copy (ver,1,1));
textcolor (color5);
write (usr,copy (ver,2,1));
textcolor (color6);
write (usr,copy (ver,3,1));
textcolor (color7);
write (usr,copy (ver,4,1)+' ');
textcolor (color8);
write (usr,copy (date,1,1));
textcolor (color9);
write (usr,copy (date,2,1));
textcolor (color10);
write (usr,copy (date,3,1));
textcolor (color11);
write (usr,copy (date,4,1));
textcolor (color12);
write (usr,copy (date,5,1));
textcolor (color13);
write (usr,copy (date,6,1));
textcolor (color14);
write (usr,copy (date,7,1));
textcolor (color15);
write (usr,copy (date,8,1));
textcolor (normtopcolor);
gotoxy (42,4);
write (usr,numcallers:0:0);
writeavail;
{gotoxy(1,7); write(usr,dszlogname);
gotoxy(1,8); write(usr,sklog);
col2;}
gotoxy (18,6);
writeln (usr,newcalls);
gotoxy (42,6);
writeln (usr,newposts);
{ writeln (usr,numminsused.total:0:0);
write (usr,numminsxfer.total:0:0);
gotoxy (1,10);}
gotoxy (67,6);
writeln(usr,newuploads);
gotoxy (18,7);
writeln(usr,newfeedback);
gotoxy (42,7);
writeln(usr,newmail);
gotoxy (67,7);
writeln(usr,numsmail);
gotoxy (16,2);
writeln(usr,reg.handle);
gotoxy (56,2);
writeln(usr,strlong(reg.serial));
gotoxy(37,22);
textcolor (normtopcolor);
writeln(usr,'Waiting for Call');
end;
if usemouse then
showmouse;
repeat
checkday;
drawstatus;
cnt:=0;
if screenblank then begin
cursor (false);
{for iiii:=1 to 15 do begin
gotoxy (10,iiii+1);
textcolor (iiii);
write (usr,'[Screen Saver ON - Press ALT-B to turn off Screen Saver]');
gotoxy (1,iiii+1);
delay (100);
clreol;
end;}
end;
repeat
{ while (answerring<1) and (not carrier) and (numchars>0) do begin
k:=getchar;
case k of
'2':phonesringing;
'1','3','5':connectcode(k)
end
end; }
cnt:=cnt+1
until (cnt>=500) or interrupted (false) or done;
until done;
end;
var k:char; time,num:integer;
mi:minuterec;
label exit;
begin
waitforacall:=false;
{arq:=false;}
doanswer;
setparam (usecom,defbaudrate,false);
if offcall then sendmodemstr ('~~ATM0H1|',true);
setupmodem;
if (offcall) or (offlocal) then sendmodemstr ('~~ATH|',true);
starttimer (numminsidle);
starttimer (blanker);
color1:=1;
color2:=2;
color3:=3;
color4:=4;
color5:=5;
color6:=6;
color7:=7;
color8:=8;
color9:=9;
color10:=10;
color11:=11;
color12:=12;
color13:=13;
color14:=14;
color15:=15;
wscount:=0;
local:=false;
screenblank:=false;
clrscr;
repeat
doanswer;
if not carrier Then Begin
clearoutput;
clearinput;
End;
mustgetbaud:=true;
k:=statusscreen;
if carrier then begin
receivecall;
if carrier then goto exit;
end;
case ord(k)-128 of
48:{if not screenblank then screenblank:=true else}
begin
screenblank:=false;
stoptimer2 (blanker);
end;
59:if usenet then begin if usemouse then hidemouse; clrscr; NewNetSend; end;
60:begin
if usemouse then hidemouse;
gotoxy(37,22);
textcolor (normtopcolor);
write(usr,'Exiting FAQ ');
writestatus;
exitprog;
end;
61:begin
writestatus;
gotoxy(37,22);
textcolor (normtopcolor);
write(usr,'Modem Carrier On');
sendmodemstr('ATA|',true);
end;
62:begin
writestatus;
gotoxy(37,22);
textcolor (normtopcolor);
if not modemoff then write(usr,'Modem Off Hook ') else
write (usr,'Modem On Hook ');
if modemoff then begin
sendmodemstr('ATH|',true);
modemoff:=false end else begin
sendmodemstr('ATH1|',true);
modemoff:=true;
end
end;
63:begin
if usemouse then hidemouse;
cursor (true);
Run_Prot_Config;
end;
64:Begin
if usemouse then hidemouse;
cursor (true);
Run_Config; Readconfig;
End;
65:begin
if usemouse then hidemouse;
clrscr;
writestatus;
ClosePort;
cursor (true);
ansicolor (7);
textcolor (7);
halt (121);
end;
66:begin
if usemouse then hidemouse;
window (1,1,80,25);
clrscr;
unum:=lookupuser (sysopname);
if unum=0 then begin
writeln ('No Sysop Created.');
delay (1000);
end;
readurec;
urec.timetoday:=10000;
cursor (true);
readfeedback;
newfeedback:=0;
urec.timetoday:=time;
writeurec;
clrscr;
end;
67:begin
if usemouse then hidemouse;
window (1,1,80,25);
clrscr;
unum:=lookupuser (sysopname);
if unum=0 then begin
writeln ('No Sysop Created.');
delay (1000);
end;
readurec;
urec.timetoday:=10000;
cursor (true);
mainsysopcommands;
urec.timetoday:=time;
writeurec;
clrscr;
end;
68:begin
if usemouse then hidemouse;
dontanswer;
modeminlock:=true;
modemoutlock:=true;
local:=true;
online:=false;
if (offlocal) and (local) and (not online) then begin
sendmodemstr ('~~ATM0H1|',true);
end;
if newfeedback<>0 then newfeedback:=0;
if newuploads<>0 then newuploads:=0;
if newcalls<>0 then newcalls:=0;
if newposts<>0 then newposts:=0;
if newmail<>0 then newmail:=0;
writestatus;
{setcursor(cursoron);}cursor(true);
goto exit
end
end;
until 0=1;
exit:
if usemouse then hidemouse;
textcolor (normbotcolor);
window (1,1,80,25);
clrscr;
end;
begin
end.